Attribute VB_Name = "modIPOWLHook"
'***************************************************************
' (c) Copyright 2000 Matthew J. Curland
'
' This file is from the CD-ROM accompanying the book:
' Advanced Visual Basic 6: Power Techniques for Everyday Programs
'   Author: Matthew Curland
'   Published by: Addison-Wesley, July 2000
'   ISBN: 0-201-70712-8
'   http://www.PowerVB.com
'
' You are entitled to license free distribution of any application
'   that uses this file if you own a copy of the book, or if you
'   have obtained the file from a source approved by the author. You
'   may redistribute this file only with express written permission
'   of the author.
'
' This file depends on:
'   References:
'     VBoostTypes6.olb (VBoost Object Types (6.0))
'     OleTypes.olb (VBoost: Ole Type Definitions)
'     VBoost6.Dll (VBoost Object Implementation (6.0)) (optional)
'   Files:
'     VBoost.Bas
'   Minimal VBoost conditionals:
'     VBOOST_INTERNAL = 1 : VBOOST_CUSTOM = 1 : VBOOST_AggregateUnknown = 1 : 
'     VBOOST_BLIND = 1 : VBOOST_BLIND_32 = 1
'   Conditional Compilation Values:
'     None
'
' This file is discussed in Chapter 16.
'***************************************************************
Option Explicit

'This file requires:
' References:
'   VBoostObjectTypes6.olb (VBoost Object Types (6.0))
'   VBoost6.Dll (VBoost Object Implementation (6.0)) (optional)
'   OleTypes.olb (VBoost: Ole Type Definitions)
' Files:
'   VBoost.Bas
' Minimal VBoost conditionals:
'   VBOOST_INTERNAL = 1 : VBOOST_CUSTOM = 1 : VBOOST_AggregateUnknown = 1 :
'   VBOOST_BLIND = 1 : VBOOST_BLIND_32 = 1

'Hooking code to redirect IOleInPlaceObjectWindowless OnWindowMessage
Private Const cIPOWLVTableSize As Long = 11
Private Type VTables
    IPOWLVTable(cIPOWLVTableSize - 1) As Long
    DelayVTable(3) As Long
End Type
Private m_VTables As VTables
Private m_pIPOWLVTable As Long
Private m_pDelayVTable As Long

Private IID_IUnknown As IID
Private IID_IDelayCreation As IID
Private IID_IOleInPlaceObjectWindowless As IID

Public Enum NotifyMessage
    nmNotifyBefore = 1
    nmNotifyAfter = 2
End Enum
Private Type IPOWLHook
    'Explicitly duplicate the BlindDelegator structure so that we can
    'set the type of the pInner entry and assign directly to the pInner
    'and pOuter entries without using CreateDelegator.
    'BD As BlindDelegator
    pVTable As Long
    pInner As IOleInPlaceObjectWindowless
    pOuter As IUnknown
    cRefs As Long
    pfnDestroy As Long
    'End of expanded BlindDelegator structure
    MessageHook As IHookWindowlessMessage 'Strong ref, cleared by DestroyIPOWLHook
    NotifyType As NotifyMessage
End Type

Public Type WindowlessSubclass
    pVTableDelay As Long 'VTable for IDelayCreation implementation
    pIPOWLNative As Long 'Weak reference to native IOleInPlaceObjectWindowless implementation
    pControllingUnknown As Long 'Weak reference to controlling IUnknown
    pHookMessage As Long 'Weak reference to IHookWindowlessMessage implementation
    Hook As IPOWLHook    'Actual hook object
End Type

Public Function InitializeWindowlessSubclass(WLSC As WindowlessSubclass, ByVal Ctl As IUnknown, ByVal NotifyType As NotifyMessage, AggData As AggregateData, IID As IID, ByVal IIDNumber As Long)
Dim pIPOWL As IOleInPlaceObjectWindowless
Dim pHook As IHookWindowlessMessage
    Set pIPOWL = Ctl
    Set pHook = Ctl
    If VBoost Is Nothing Then InitVBoost
    If m_pDelayVTable = 0 Then InitVTables
    With WLSC
        .pVTableDelay = m_pDelayVTable
        VBoost.Assign .pControllingUnknown, Ctl
        VBoost.Assign .pIPOWLNative, pIPOWL
        VBoost.Assign .pHookMessage, pHook
        With .Hook
            .pVTable = m_pIPOWLVTable
            .pfnDestroy = FuncAddr(AddressOf DestroyIPOWLHook)
            .NotifyType = NotifyType
        End With
    End With
    IID = IID_IOleInPlaceObjectWindowless
    With AggData
        .Flags = adUseIIDs Or adNoDelegator Or adBeforeHookedUnknown Or adDelayDontCacheResolved Or adFullyResolved
        .FirstIID = IIDNumber
        VBoost.Assign .pObject, VarPtr(WLSC)
    End With
End Function

Private Sub InitVTables()
    With m_VTables
        'Set up the hook vtable
        CopyMemory .IPOWLVTable(0), ByVal VBoost.BlindFunctionPointer(-1), 4 * cIPOWLVTableSize
        .IPOWLVTable(9) = FuncAddr(AddressOf OnWindowMessage)
        m_pIPOWLVTable = VarPtr(.IPOWLVTable(0))
        
        'Setup the delay creation vtable
        .DelayVTable(0) = FuncAddr(AddressOf IDelayCreation_QueryInterface)
        .DelayVTable(1) = FuncAddr(AddressOf AddRefRelease)
        .DelayVTable(2) = .DelayVTable(1)
        .DelayVTable(3) = FuncAddr(AddressOf IDelayCreation_Create)
        m_pDelayVTable = VarPtr(.DelayVTable(0))
    End With
    IID_IUnknown = IIDFromString(strIID_IUnknown)
    IID_IDelayCreation = IIDFromString(strIID_IDelayCreation)
    IID_IOleInPlaceObjectWindowless = IIDFromString(strIID_IOleInPlaceObjectWindowless)
End Sub
Private Function IDelayCreation_QueryInterface(This As WindowlessSubclass, riid As IID, pvObj As Long) As Long
Dim fOK As BOOL
    Select Case riid.Data1
        Case 0& 'IID_IUnknown.Data1
            fOK = IsEqualIID(riid, IID_IUnknown)
        Case &H20708EE6 'IID_IDelayCreation.Data1
            fOK = IsEqualIID(riid, IID_IDelayCreation)
    End Select
    If fOK Then
        pvObj = VarPtr(This)
    Else
        pvObj = 0
        IDelayCreation_QueryInterface = E_NOINTERFACE
    End If
End Function
Private Function AddRefRelease(ByVal This As Long) As Long
    'Nothing to do
End Function
Private Function IDelayCreation_Create(This As WindowlessSubclass, riid As IID, pvObj As Long) As Long
    With This.Hook
        If .cRefs = 0 Then
            VBoost.AssignAddRef .pInner, This.pIPOWLNative
            VBoost.AssignAddRef .pOuter, This.pControllingUnknown
            VBoost.AssignAddRef .MessageHook, This.pHookMessage
        End If
        .cRefs = .cRefs + 1
        pvObj = VarPtr(.pVTable)
    End With
End Function
Private Function DestroyIPOWLHook(This As IPOWLHook, pInner As IUnknown, pOuter As IUnknown) As Long
    'Clear AccelHook so that we don't leak
    Set This.MessageHook = Nothing
End Function
Private Function OnWindowMessage(This As IPOWLHook, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, plResult As Long) As Long
Dim hrReturnCode As Long
    'Default to 'not handled' return code
    If This.NotifyType And nmNotifyBefore Then
        OnWindowMessage = 1
        On Error Resume Next
        This.MessageHook.OnWindowMessage True, uMsg, wParam, lParam, plResult, OnWindowMessage
        If Err Then OnWindowMessage = 1
        On Error GoTo 0
        If OnWindowMessage Then
            OnWindowMessage = This.pInner.OnWindowMessage(uMsg, wParam, lParam, plResult)
        End If
    Else
        OnWindowMessage = This.pInner.OnWindowMessage(uMsg, wParam, lParam, plResult)
    End If
    
    If This.NotifyType And nmNotifyAfter Then
        'Notify after regardless of success
        hrReturnCode = OnWindowMessage
        On Error Resume Next
        'Ignore return code on error
        This.MessageHook.OnWindowMessage False, uMsg, wParam, lParam, plResult, hrReturnCode
        If Err = 0 Then OnWindowMessage = hrReturnCode
        On Error GoTo 0
    End If
End Function
Private Function FuncAddr(ByVal pfn As Long) As Long
    FuncAddr = pfn
End Function

